home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / util / gnu / emacs_src_18_58.lha / emacs-18.58 / lisp / dabbrev.el < prev    next >
Lisp/Scheme  |  1992-02-21  |  9KB  |  222 lines
  1. ;; Dynamic abbreviation package for GNU Emacs.
  2. ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is free software; you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation; either version 1, or (at your option)
  9. ;; any later version.
  10.  
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;; GNU General Public License for more details.
  15.  
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  18. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20.  
  21. ; DABBREVS - "Dynamic abbreviations" hack, originally written by Don Morrison
  22. ; for Twenex Emacs.  Converted to mlisp by Russ Fish.  Supports the table
  23. ; feature to avoid hitting the same expansion on re-expand, and the search
  24. ; size limit variable.  Bugs fixed from the Twenex version are flagged by
  25. ; comments starting with ;;; .
  26. ; 
  27. ; converted to elisp by Spencer Thomas.
  28. ; Thoroughly cleaned up by Richard Stallman.
  29. ;  
  30. ; If anyone feels like hacking at it, Bob Keller (Keller@Utah-20) first
  31. ; suggested the beast, and has some good ideas for its improvement, but
  32. ; doesn?tknow TECO (the lucky devil...).  One thing that should definitely
  33. ; be done is adding the ability to search some other buffer(s) if you can?t
  34. ; find the expansion you want in the current one.
  35.  
  36. ;; (defun dabbrevs-help ()
  37. ;;   "Give help about dabbrevs."
  38. ;;   (interactive)
  39. ;;   (&info "emacs" "dabbrevs")    ; Select the specific info node.
  40. ;; )
  41. (provide 'dabbrevs)
  42.  
  43. (defvar dabbrevs-limit nil
  44.   "*Limits region searched by dabbrevs-expand to that many chars away (local).")
  45. (make-variable-buffer-local 'dabbrevs-limit)
  46.  
  47. (defvar dabbrevs-backward-only nil
  48.   "*If non-NIL, dabbrevs-expand only looks backwards.")
  49.  
  50. ; State vars for dabbrevs-re-expand.
  51. (defvar last-dabbrevs-table nil
  52.   "Table of expansions seen so far. (local)")
  53. (make-variable-buffer-local 'last-dabbrevs-table)
  54.  
  55. (defvar last-dabbrevs-abbreviation ""
  56.   "Last string we tried to expand.  Buffer-local.")
  57. (make-variable-buffer-local 'last-dabbrevs-abbreviation)
  58.  
  59. (defvar last-dabbrevs-direction 0
  60.   "Direction of last dabbrevs search. (local)")
  61. (make-variable-buffer-local 'last-dabbrevs-direction)
  62.  
  63. (defvar last-dabbrevs-abbrev-location nil
  64.   "Location last abbreviation began (local).")
  65. (make-variable-buffer-local 'last-dabbrevs-abbrev-location)
  66.  
  67. (defvar last-dabbrevs-expansion nil
  68.     "Last expansion of an abbreviation. (local)")
  69. (make-variable-buffer-local 'last-dabbrevs-expansion)
  70.  
  71. (defvar last-dabbrevs-expansion-location nil
  72.   "Location the last expansion was found. (local)")
  73. (make-variable-buffer-local 'last-dabbrevs-expansion-location)
  74.  
  75. (defun dabbrev-expand (arg)
  76.   "Expand previous word \"dynamically\".
  77. Expands to the most recent, preceding word for which this is a prefix.
  78. If no suitable preceding word is found, words following point are considered.
  79.  
  80. A positive prefix argument, N, says to take the Nth backward DISTINCT
  81. possibility.  A negative argument says search forward.  The variable
  82. dabbrev-backward-only may be used to limit the direction of search to
  83. backward if set non-nil.
  84.  
  85. If the cursor has not moved from the end of the previous expansion and
  86. no argument is given, replace the previously-made expansion
  87. with the next possible expansion not yet tried."
  88.   (interactive "*P")
  89.   (let (abbrev expansion old which loc n pattern
  90.     (do-case (and case-fold-search case-replace)))
  91.     ;; abbrev -- the abbrev to expand
  92.     ;; expansion -- the expansion found (eventually) or nil until then
  93.     ;; old -- the text currently in the buffer
  94.     ;;    (the abbrev, or the previously-made expansion)
  95.     ;; loc -- place where expansion is found
  96.     ;;    (to start search there for next expansion if requested later)
  97.     ;; do-case -- nil if should consider case significant.
  98.     (save-excursion
  99.       (if (and (null arg)
  100.            (eq last-command this-command)
  101.            last-dabbrevs-abbrev-location)
  102.       (progn
  103.         (setq abbrev last-dabbrevs-abbreviation)
  104.         (setq old last-dabbrevs-expansion)
  105.         (setq which last-dabbrevs-direction))
  106.     (setq which (if (null arg)
  107.             (if dabbrevs-backward-only 1 0)
  108.                 (prefix-numeric-value arg)))
  109.     (setq loc (point))
  110.     (forward-word -1)
  111.     (setq last-dabbrevs-abbrev-location (point)) ; Original location.
  112.     (setq abbrev (buffer-substring (point) loc))
  113.     (setq old abbrev)
  114.     (setq last-dabbrevs-expansion-location nil)
  115.     (setq last-dabbrev-table nil))      ; Clear table of things seen.
  116.  
  117.       (setq pattern (concat "\\b" (regexp-quote abbrev) "\\(\\sw\\|\\s_\\)+"))
  118.       ;; Try looking backward unless inhibited.
  119.       (if (>= which 0)
  120.       (progn 
  121.         (setq n (max 1 which))
  122.         (if last-dabbrevs-expansion-location
  123.         (goto-char last-dabbrevs-expansion-location))
  124.         (while (and (> n 0)
  125.             (setq expansion (dabbrevs-search pattern t do-case)))
  126.           (setq loc (point-marker))
  127.           (setq last-dabbrev-table (cons expansion last-dabbrev-table))
  128.           (setq n (1- n)))
  129.         (or expansion
  130.         (setq last-dabbrevs-expansion-location nil))
  131.         (setq last-dabbrevs-direction (min 1 which))))
  132.  
  133.       (if (and (<= which 0) (not expansion)) ; Then look forward.
  134.       (progn 
  135.         (setq n (max 1 (- which)))
  136.         (if last-dabbrevs-expansion-location
  137.         (goto-char last-dabbrevs-expansion-location))
  138.         (while (and (> n 0)
  139.             (setq expansion (dabbrevs-search pattern nil do-case)))
  140.           (setq loc (point-marker))
  141.           (setq last-dabbrev-table (cons expansion last-dabbrev-table))
  142.           (setq n (1- n)))
  143.         (setq last-dabbrevs-direction -1))))
  144.  
  145.     (if (not expansion)
  146.     (let ((first (string= abbrev old)))
  147.       (setq last-dabbrevs-abbrev-location nil)
  148.       (if (not first)
  149.           (progn (undo-boundary)
  150.              (delete-backward-char (length old))
  151.              (insert abbrev)))
  152.       (error (if first
  153.              "No dynamic expansion for \"%s\" found."
  154.              "No further dynamic expansions for \"%s\" found.")
  155.          abbrev))
  156.       ;; Success: stick it in and return.
  157.       (undo-boundary)
  158.       (search-backward old)
  159.       ;; Make case of replacement conform to case of abbreviation
  160.       ;; provided (1) that kind of thing is enabled in this buffer
  161.       ;; and (2) the replacement itself is all lower case
  162.       ;; except perhaps for the first character.
  163.       (let ((do-case (and do-case
  164.               (string= (substring expansion 1)
  165.                    (downcase (substring expansion 1))))))
  166.     ;; First put back the original abbreviation with its original
  167.     ;; case pattern.
  168.     (save-excursion
  169.       (replace-match abbrev t 'literal))
  170.     (search-forward abbrev)
  171.     (replace-match (if do-case (downcase expansion) expansion)
  172.                (not do-case)
  173.                'literal))
  174.       ;; Save state for re-expand.
  175.       (setq last-dabbrevs-abbreviation abbrev)
  176.       (setq last-dabbrevs-expansion expansion)
  177.       (setq last-dabbrevs-expansion-location loc))))
  178.  
  179. ;; Search function used by dabbrevs library.  
  180. ;; First arg is string to find as prefix of word.  Second arg is
  181. ;; t for reverse search, nil for forward.  Variable dabbrevs-limit
  182. ;; controls the maximum search region size.
  183.  
  184. ;; Table of expansions already seen is examined in buffer last-dabbrev-table,
  185. ;; so that only distinct possibilities are found by dabbrevs-re-expand.
  186. ;; Note that to prevent finding the abbrev itself it must have been
  187. ;; entered in the table.
  188.  
  189. ;; Value is the expansion, or nil if not found.  After a successful
  190. ;; search, point is left right after the expansion found.
  191.  
  192. (defun dabbrevs-search (pattern reverse do-case)
  193.   (let (missing result)
  194.     (save-restriction         ; Uses restriction for limited searches.
  195.       (if dabbrevs-limit
  196.       (narrow-to-region last-dabbrevs-abbrev-location
  197.                 (+ (point)
  198.                    (* dabbrevs-limit (if reverse -1 1)))))
  199.       ;; Keep looking for a distinct expansion.
  200.       (setq result nil)
  201.       (setq missing nil)
  202.       (while  (and (not result) (not missing))
  203.     ; Look for it, leave loop if search fails.
  204.     (setq missing
  205.           (not (if reverse
  206.                (re-search-backward pattern nil t)
  207.                (re-search-forward pattern nil t))))
  208.  
  209.     (if (not missing)
  210.         (progn
  211.           (setq result (buffer-substring (match-beginning 0)
  212.                          (match-end 0)))
  213.           (let* ((test last-dabbrev-table))
  214.         (while (and test
  215.                 (not
  216.                  (if do-case
  217.                  (string= (downcase (car test)) (downcase result))
  218.                    (string= (car test) result))))
  219.           (setq test (cdr test)))
  220.         (if test (setq result nil))))))    ; if already in table, ignore
  221.       result)))
  222.